perm filename CLIP.F4[IRC,LCS] blob sn#493208 filedate 1980-01-11 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE CLIP(J,K,L)
C00005 ENDMK
CāŠ—;
	SUBROUTINE CLIP(J,K,L)
C		   (AC13,AC14,AC7)
	COMMON /JCLIP/MC,NC,N
C ASSUMES N IS INITIALIZED =0
	DATA MC/200/,NC/600/
C  SMALL DIM. OF PAPER IS C.600 TO -1000   MOVE IN 400 INCREMENTS.
	IF(L.NE.3)GO TO 1
C NOW INBOUNDS
	N=0
	IF(K.LT.MC.OR.K.GE.NC)N=-1
	GO TO 4
1	IF(N.EQ.0)GO TO 11
C JUMP IF LAST POINT WAS IN BOUNDS
C NOW JJ IS OUT OF BOUNDS, CLIP IT
5	IF(K.LT.MC.AND.KK.LT.MC)GO TO 9
	IF(K.GE.NC.AND.KK.GE.NC)GO TO 9
C GO BACK IF ENTIRE SEGMENT IS OUT OF BOUNDS
6	CALL CL(JX,KX,J,K,JJ,KK)
C CLIP FROM INVIS VECT WHICH IS OUT OF BOUNDS OR V-V
8	CALL NVECT(JX,KX)
C GO PUT AWAY CLIPPED VECTOR POINT, THEN NEW POINT
C CLIP MORE IF OTHER POINT IS ALSO OUT.
11	IF(K.LT.MC.OR.K.GE.NC)GO TO 7
	N=0
	GO TO 4
9	N=-1
4	JJ=J
	KK=K
C REMEMBER THE COORDS.
	RETURN
7 	CALL CL(JX,KX,JJ,KK,J,K)
	JJ=J
	KK=K
	J=JX
	K=KX
	N=1  
	RETURN
	END

	SUBROUTINE CL(JX,KX,J,K,JJ,KK)
C                 RETURN -- IN -- OUT
	COMMON /JCLIP/MC,NC
C JJ,KK=OLD POINT    J,K=NEW POINT  JX,KX=CLIPPED
	KX=NC-1
	IF(KK.LT.NC)KX=MC
C JUMP IF OFF TOP OF AREA
C NOW IT'S OFF BOTTOM OF AREA
1	A=KK-K
	B=(JJ-J)*(KX-K)
	C=B/A
	JX=J+C
C NOW THE VECT. IS FROM KX,JX TO J,K -- ALL INBOUNDS.
	END